El modelamiento del comportamiento de diferentes variables es un tema que ha sido estudiado en sectores energéticos, industriales, económicos y financieros. De allí se comienza a apreciar tanto la importancia que tienen los datos hoy en día al igual que las técnicas utilizadas para su modelamiento. La estadística es una disciplina que se preocupa por la recolección, organización, interpretación y análisis de datos, que, según su aplicación puede traer un gran impacto en la industria al momento de la toma de decisiones. En particular, diferentes técnicas estadísticas han sido utilizadas en el sector financiero, las cuales permiten modelar comportamiento de los clientes, acciones, entre otras variables.
Diferentes industrias dentro de su funcionamiento, deben presentar ante la superintendencia información relacionando los gastos y ventas que presentaron anualmente. Además, se presume que del mercado colombiano, como en los procesos de las industria está esa interacción con todo el mercado, es posible pensar que exista una relación entre las diferentes variables macroeconomicas (ej. PIB, TRM, Balance Fiscal, Indice de Desempleo, etc.) y estos montos de costos y gastos de las empresas. Debido a la cantidad de información con la que se cuenta (información de costos y gastos para diferentes empresas en colombia entre los años 2016 y 2018), se sabe que no se cuenta con información suficiente para la construcción de un modelo por empresa que permita ver la relación existente entre las variables macroeconómicas y las variables asociadas a costos y gastos de ventas. Por lo anterior, es posible considerar un conjunto de datos como la consolidación de la información de todas las empresas junto con la información macroeconomica para los años en estudio, así buscando construir un modelo general para realizar la modelación de estas variables reportadas ante la superintendencia para un conjunto de empresas cuya industria sea similar.
Por lo tanto, para el conjunto de datos meniconado anteriormente, se buscará modelar la información de costos y gastos de venta a partir de las variables macroeconomicas disponibles, al igual que analizar si al realizar alguna transformación a dichas variables resulta relevante al momento de la creación del modelo. Se utilizarán modelos lineales, comenzando con la evaluación del modelo lineal general, hasta la aplicación de modelos de efectos mixtos. Esta última estructura de modelos, es bastante usado al momento de tener individuos que comparten la misma información pero tienen una salida diferente (en nuestro caso, todas las empresas comparten la misma información de las variables macroeconómicas), por lo que utilizar este tipo de modelos resulta de gran interés ya que permite modelar tanto efectos a nivel de individuo como agregando un efecto aleatorio.
El sector de la construcción es uno de los más relevantes en la economía colombiana. En nuestro contexto nacional el sector es considerado como uno de los más vitales para el desarrollo del país y representa uno de los más importantes rubros en materia de produccción interna componiendo cada año de 6 a 7 por ciento del producto interno bruto total y hasta un 7.1% del total de ocupados a nivel nacional. Dicho sector es caracterizado por sus fluctuaciones estacionarias fuertemente influenciadas por los planes de infraestructura de gran escala y los planes de gobierno. Respecto al último trimestre de 2019 tuvo un aumento de 3.4%, uno de los más altos a nivel de america latina.
Si bien las estimaciones globales para el año 2020 en Colombia para esta industria eran positivas, la coyuntura del COVID-19 ha de perturbar fuertemente el sector, afectando con alto impacto a los importadores de materiales y a la demanada frente a los retrasos en la ejecución de obras. Desde enero el sector de la producción de concreto ya estaba presentando caídas significativas de hasta un 8.3% respecto al año pasado en el mismo mes, por lo que se esperan peores resultados al cierre del segundo trimestre del año presente. Muchas compañías planearon incrementos en sus precios, con la esperanza de generar mayores ingresos, pero dichos planes han de ser postergados bajo la actual coyuntura. La demanda, el driver más relevante en la industria, claramente se ve desplazado efecto del impedimento de comercialización y la paralisis en el país bajo las medidas de cuarentena nacional. Un punto importante es que algunas compañías del sector podrán seguir con sus actividades producto de la inclusión de actividades de infraestructura como vital durante la crisis del COVID-19.
Frente a la incertidumbre que generan estos escenarios y como la dinámica particular de cada compañía que aporta al crecimiento de la industria total evoluciona en el tiempo se torna relevante construir análisis y modelos estadísticos robustos que respondan a las perturbaciones en el mercado y permitan obtener información valiosa para la toma de decisiones.
all_data = read.csv("PreparacionDatos/Datos_completos.csv", encoding="UTF-8")
NIT = all_data['NIT']
data = all_data[,-c(1,2)]
Damos una visualizacion inicial al conjunto de datos con el que se va a trabajar:
kable(head(round(data,2))) %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "center", fixed_thead = T)%>%
scroll_box("100%", height = "300px")
| Costo.de.ventas | Gastos.de.ventas | Costo.de.ventas_dif | Gastos.de.ventas_dif | TRM | PIB | Desempleo | Inflacion | Tasa_Intervencion | Balance_CC | Balance_Fiscal |
|---|---|---|---|---|---|---|---|---|---|---|
| 60626083 | 13978834 | -0.10 | 0.14 | 0.11 | 0.07 | 0.09 | 0.06 | 0.52 | 0.35 | 0.27 |
| 3785517 | 60608 | 0.07 | 0.33 | 0.11 | 0.07 | 0.09 | 0.06 | 0.52 | 0.35 | 0.27 |
| 39634059 | 5645885 | 0.34 | 0.69 | 0.11 | 0.07 | 0.09 | 0.06 | 0.52 | 0.35 | 0.27 |
| 24304534 | 8977594 | -0.05 | -0.04 | 0.11 | 0.07 | 0.09 | 0.06 | 0.52 | 0.35 | 0.27 |
| 31280967 | 6702215 | -0.05 | -0.18 | 0.11 | 0.07 | 0.09 | 0.06 | 0.52 | 0.35 | 0.27 |
| 11886427 | 1050755 | 0.13 | 0.03 | 0.11 | 0.07 | 0.09 | 0.06 | 0.52 | 0.35 | 0.27 |
En la siguiente tabla, vemos información descriptiva de las variables que se considerarán en la etapa de modelamiento del trabajo, vemos así que contamos con un total de 11 variables, cada una con magnitudes diferentes. Vemos que algunos indicadores tienen valores entre 0 y 1 tal como lo es el desempleo, mientras que otras variables representan dinero, tal como la trm, el monto de gastos y ventas. Así, tenemos una idea inicial de las características del conjunto de datos, por lo que se aplicarán lo métodos correspondientes cuando sea necesario, si lo que se realizará es sensible a la escala de los datos.
summary_df = stat.desc(data)
kable(summary_df) %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "center", fixed_thead = T)%>%
scroll_box("100%", height = "300px")
| Costo.de.ventas | Gastos.de.ventas | Costo.de.ventas_dif | Gastos.de.ventas_dif | TRM | PIB | Desempleo | Inflacion | Tasa_Intervencion | Balance_CC | Balance_Fiscal | |
|---|---|---|---|---|---|---|---|---|---|---|---|
| nbr.val | 9.900000e+01 | 9.900000e+01 | 99.0000000 | 99.0000000 | 99.0000000 | 99.0000000 | 99.0000000 | 99.0000000 | 99.0000000 | 99.0000000 | 99.0000000 |
| nbr.null | 0.000000e+00 | 0.000000e+00 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 |
| nbr.na | 0.000000e+00 | 0.000000e+00 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 |
| min | 5.913660e+05 | 3.436800e+04 | -0.9289315 | -0.7898731 | -0.0334936 | 0.0656288 | 0.0922332 | 0.0318000 | -0.2895537 | -0.2740147 | -0.2287460 |
| max | 2.119141e+08 | 3.541196e+07 | 1.0883866 | 6.1607837 | 0.1117616 | 0.0734318 | 0.0968134 | 0.0575000 | 0.5192874 | 0.3516454 | 0.2726036 |
| range | 2.113227e+08 | 3.537760e+07 | 2.0173181 | 6.9506568 | 0.1452552 | 0.0078030 | 0.0045802 | 0.0257000 | 0.8088411 | 0.6256601 | 0.5013496 |
| sum | 4.755036e+09 | 6.487101e+08 | -3.7634585 | 6.2073859 | 2.6432290 | 6.9358217 | 9.3332892 | 4.2966000 | 3.0437504 | 7.4840537 | -0.5776688 |
| median | 3.527843e+07 | 5.204078e+06 | -0.0254994 | 0.0107538 | 0.0018298 | 0.0711158 | 0.0937804 | 0.0409000 | -0.1374988 | 0.1491588 | -0.0613627 |
| mean | 4.803067e+07 | 6.552627e+06 | -0.0380147 | 0.0627009 | 0.0266993 | 0.0700588 | 0.0942756 | 0.0434000 | 0.0307450 | 0.0755965 | -0.0058350 |
| SE.mean | 4.567598e+06 | 6.609484e+05 | 0.0279735 | 0.0665708 | 0.0062481 | 0.0003305 | 0.0001922 | 0.0010748 | 0.0354548 | 0.0263314 | 0.0210523 |
| CI.mean.0.95 | 9.064249e+06 | 1.311631e+06 | 0.0555124 | 0.1321077 | 0.0123991 | 0.0006559 | 0.0003814 | 0.0021329 | 0.0703589 | 0.0522538 | 0.0417776 |
| var | 2.065432e+15 | 4.324843e+13 | 0.0774690 | 0.4387361 | 0.0038648 | 0.0000108 | 0.0000037 | 0.0001144 | 0.1244474 | 0.0686408 | 0.0438768 |
| std.dev | 4.544702e+07 | 6.576354e+06 | 0.2783325 | 0.6623716 | 0.0621675 | 0.0032887 | 0.0019121 | 0.0106940 | 0.3527710 | 0.2619939 | 0.2094678 |
| coef.var | 9.462084e-01 | 1.003621e+00 | -7.3217010 | 10.5639935 | 2.3284333 | 0.0469421 | 0.0202817 | 0.2464057 | 11.4741097 | 3.4656883 | -35.8982759 |
Además de la información descriptiva presentados en la tabla anterior, podemos ver para cada una de las variables, su distribución de forma visual con la ayuda de la creación de histogramas de frecuencia.
Vamos a obtener la informacion relacionada a las medidas de centralidad y dispersion del conjunto de datos. Inicialmente, presentamos información del vector de medias y medianas que describen la centralidad del conjunto de datos. Posteriormente, consideramos las matrices de Covarianza y Correlación para tener una intuición de la variabilidad de la información que consideramos.
|
|
par(mfrow=c(1,2))
bxplot_costos = boxplot(Costo.de.ventas~Year, data = all_data)
bxplot_gastos = boxplot(Gastos.de.ventas~Year, data = all_data)
### Outliers para costos
nits_tab = t(all_data[(all_data$Costo.de.ventas %in% bxplot_costos$out),]$NIT)
rownames(nits_tab) <- c("NITs")
kable(nits_tab)%>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "center", fixed_thead = T)%>%
column_spec(1,bold=T)
| NITs | 860009694 | 900378893 | 860009694 | 900378893 | 860009694 | 900378893 |
### Outliers para gastos
nits_tab = t(all_data[(all_data$Gastos.de.ventas %in% bxplot_gastos$out),]$NIT)
rownames(nits_tab) <- c("NITs")
kable(nits_tab)%>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "center", fixed_thead = T)%>%
column_spec(1,bold=T)
| NITs | 801002644 | 801002644 | 800015615 | 801002644 |
par(mfrow=c(1,2))
bxplot_costos_dif = boxplot(Costo.de.ventas_dif~Year, data = all_data)
bxplot_gastos_dif = boxplot(Gastos.de.ventas_dif~Year, data = all_data)
### Outliers para costos dif
nits_tab = t(all_data[(all_data$Costo.de.ventas_dif %in% bxplot_costos_dif$out),]$NIT)
rownames(nits_tab) <- c("NITs")
kable(nits_tab)%>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "center", fixed_thead = T)%>%
column_spec(1,bold=T)
| NITs | 800236890 | 890909034 | 900437650 | 800236890 | 890909034 | 900389088 | 800236890 |
### Outliers para gastos dif
nits_tab = t(all_data[(all_data$Gastos.de.ventas_dif %in% bxplot_gastos_dif$out),]$NIT)
rownames(nits_tab) <- c("NITs")
kable(nits_tab)%>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "center", fixed_thead = T)%>%
column_spec(1,bold=T)
| NITs | 800081030 | 890904459 | 900389088 | 800045720 | 800236890 | 890311366 | 890909034 | 900234565 | 900364670 | 900378893 |
Al observar la distribución del comportamiento de las variables de ventas y gastos para los 3 años en consideración, podemos ver que no hay mucha variación entre el comportamiento de estas a lo largo del tiempo, vemos que en particular, tanto el monto de costo y gasto promedio (mediana) es constante para los 3 años, aunque se nota un aumento en los costos en el año 2018 para el caso de algunas empresas. Ademas, vemos para que caso de los Costos, las mismas 2 empresas (relacionadas a los NITs 860009694 y 900378893) fueron las que presentaron un maypr valor de costos en los 3 periodos, por lo que el boxplot los considera registros outliers. Mirando la distribución de los gatos, notamos que una empresa tuvo los gastos mas altos en los 3 periodos (relacionadas al NIT 801002644) pero adicional, en el último año, la empresa con el NIT 800015615 tuvo un aumento en sus gastos, por lo que es considerado también como un outlier por el boxplot.
Pasando a la distribución de las variables de diferencia relativa de costos y gastos, vemos para ambos casos los registros outliers son aquellos que tienen un valor negativo en su diferencia o un incremento porcentual muy alto. Podemos ver que para el caso del 2016 en la variable costos, las empresas outliers fueron las correspondiente a los NITs 800236890, 890909034, 900437650, de estas, la única que no presenta una diferencia negativa fue la primera (800236890), por lo que puede indicar un aumento considerable (raro) en el mercado en término de los costos de venta (practicamente el doble del año anterior), mientras que todas las otras empresas presentaron una disminución considerable en este mismo concepto. Para el caso del 2017, tres empresas fueron consideradas como outlier, entre ellas, dos que se consideraron en el periodo anterior (800236890, 890909034), las cuales ambas reportaron una reducción de aproximadamente 65% en sus costos respecto al año anterior, mientras que la otra empresa considerada como ergistro raro (900389088) tuvo un aumento en sus costos de un 88% (casi el doble de los costos del año anterior). Para el último periodo, solo se encuentra una de las empresas mencionadas en los dos periodos anteriores (800236890), la cual vuelve a reportar una disminución considerable en sus costos.
Ahora mirando la variable de diferencia de gastos, solamente 2 empresas tienen comportamientos alto, presentando un aumento de casi el doble de los gastos anuales, estas empresas corresponden a 800081030 y 890904459 para los años 2016 y 2017 respectivamente, en cambio para el 2018, se tuvo variabilidad en los gastos de ventas de 8 empresas que son considerados anormales tanto por sus aumentos como disminuciones, auqellas empresas son 900389088, 800045720, 800236890, 890311366, 890909034, 900234565, 900364670 y 900378893. En aquellas empresas que tuvieron aumentos considerables, reportan casi hasta un cuarto del aumento de gastos en comparación al año anterior, mientras que aquellas que reportan una disminución, vemos que sus gastos se disminuyeron hasta el doble del periodo pasado.
Asi, estos cambios en las industrias en sus costos y gastos de ventas, pueden estar directamente relacionados con algunos eventos que hayan hecho la gran variación en la materia prima requerida para sus productos (tipos de mezlcas de cemento por ejemplo), además que el sector seleccionado depende bastante de los planes de infraestructura que se tengan, por lo que también es factible que en los periodos analizados, hayan ocurrido cambios en estos planes dentro de la contratación de cada empresa, y sean estas las causas que nos lleven a ver diferencias tan grandes de periodo a periodo (tanto positivas como negativas)
cov_data = cov(data)
kable(formatC(cov_data,format = "e", digits = 2)) %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "center", fixed_thead = T)%>%
scroll_box("100%", height = "480px")
| Costo.de.ventas | Gastos.de.ventas | Costo.de.ventas_dif | Gastos.de.ventas_dif | TRM | PIB | Desempleo | Inflacion | Tasa_Intervencion | Balance_CC | Balance_Fiscal | |
|---|---|---|---|---|---|---|---|---|---|---|---|
| Costo.de.ventas | 2.07e+15 | 1.35e+14 | 2.34e+06 | -1.56e+06 | 8.13e+04 | 5.00e+03 | -2.64e+02 | 6.97e+03 | 3.12e+05 | 2.99e+04 | 2.89e+05 |
| Gastos.de.ventas | 1.35e+14 | 4.32e+13 | 3.58e+05 | 1.04e+05 | 3.18e+03 | 3.62e+02 | 1.48e+02 | -3.37e+02 | -2.24e+03 | -2.08e+04 | 1.34e+04 |
| Costo.de.ventas_dif | 2.34e+06 | 3.58e+05 | 7.75e-02 | -3.65e-02 | 1.14e-03 | 9.75e-05 | 2.24e-05 | -3.04e-06 | 1.99e-03 | -3.20e-03 | 4.39e-03 |
| Gastos.de.ventas_dif | -1.56e+06 | 1.04e+05 | -3.65e-02 | 4.39e-01 | 8.23e-04 | 2.07e-04 | 1.46e-04 | -5.03e-04 | -1.05e-02 | -2.03e-02 | 4.91e-03 |
| TRM | 8.13e+04 | 3.18e+03 | 1.14e-03 | 8.23e-04 | 3.86e-03 | 1.78e-04 | -6.97e-05 | 5.52e-04 | 2.01e-02 | 9.34e-03 | 1.30e-02 |
| PIB | 5.00e+03 | 3.62e+02 | 9.75e-05 | 2.07e-04 | 1.78e-04 | 1.08e-05 | -6.78e-07 | 1.56e-05 | 6.92e-04 | 7.94e-05 | 6.29e-04 |
| Desempleo | -2.64e+02 | 1.48e+02 | 2.24e-05 | 1.46e-04 | -6.97e-05 | -6.78e-07 | 3.66e-06 | -1.92e-05 | -5.82e-04 | -5.01e-04 | -2.02e-04 |
| Inflacion | 6.97e+03 | -3.37e+02 | -3.04e-06 | -5.03e-04 | 5.52e-04 | 1.56e-05 | -1.92e-05 | 1.14e-04 | 3.71e-03 | 2.61e-03 | 1.73e-03 |
| Tasa_Intervencion | 3.12e+05 | -2.24e+03 | 1.99e-03 | -1.05e-02 | 2.01e-02 | 6.92e-04 | -5.82e-04 | 3.71e-03 | 1.24e-01 | 7.90e-02 | 6.44e-02 |
| Balance_CC | 2.99e+04 | -2.08e+04 | -3.20e-03 | -2.03e-02 | 9.34e-03 | 7.94e-05 | -5.01e-04 | 2.61e-03 | 7.90e-02 | 6.86e-02 | 2.69e-02 |
| Balance_Fiscal | 2.89e+05 | 1.34e+04 | 4.39e-03 | 4.91e-03 | 1.30e-02 | 6.29e-04 | -2.02e-04 | 1.73e-03 | 6.44e-02 | 2.69e-02 | 4.39e-02 |
cor_data = cor(data)
kable(round(cor_data,2)) %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "center", fixed_thead = T)%>%
scroll_box("100%", height = "480px")
| Costo.de.ventas | Gastos.de.ventas | Costo.de.ventas_dif | Gastos.de.ventas_dif | TRM | PIB | Desempleo | Inflacion | Tasa_Intervencion | Balance_CC | Balance_Fiscal | |
|---|---|---|---|---|---|---|---|---|---|---|---|
| Costo.de.ventas | 1.00 | 0.45 | 0.18 | -0.05 | 0.03 | 0.03 | 0.00 | 0.01 | 0.02 | 0.00 | 0.03 |
| Gastos.de.ventas | 0.45 | 1.00 | 0.20 | 0.02 | 0.01 | 0.02 | 0.01 | 0.00 | 0.00 | -0.01 | 0.01 |
| Costo.de.ventas_dif | 0.18 | 0.20 | 1.00 | -0.20 | 0.07 | 0.11 | 0.04 | 0.00 | 0.02 | -0.04 | 0.08 |
| Gastos.de.ventas_dif | -0.05 | 0.02 | -0.20 | 1.00 | 0.02 | 0.10 | 0.12 | -0.07 | -0.04 | -0.12 | 0.04 |
| TRM | 0.03 | 0.01 | 0.07 | 0.02 | 1.00 | 0.87 | -0.59 | 0.83 | 0.92 | 0.57 | 1.00 |
| PIB | 0.03 | 0.02 | 0.11 | 0.10 | 0.87 | 1.00 | -0.11 | 0.44 | 0.60 | 0.09 | 0.91 |
| Desempleo | 0.00 | 0.01 | 0.04 | 0.12 | -0.59 | -0.11 | 1.00 | -0.94 | -0.86 | -1.00 | -0.50 |
| Inflacion | 0.01 | 0.00 | 0.00 | -0.07 | 0.83 | 0.44 | -0.94 | 1.00 | 0.98 | 0.93 | 0.77 |
| Tasa_Intervencion | 0.02 | 0.00 | 0.02 | -0.04 | 0.92 | 0.60 | -0.86 | 0.98 | 1.00 | 0.85 | 0.87 |
| Balance_CC | 0.00 | -0.01 | -0.04 | -0.12 | 0.57 | 0.09 | -1.00 | 0.93 | 0.85 | 1.00 | 0.49 |
| Balance_Fiscal | 0.03 | 0.01 | 0.08 | 0.04 | 1.00 | 0.91 | -0.50 | 0.77 | 0.87 | 0.49 | 1.00 |
corrplot(cor_data, method="circle")
Dado que en este trabajo se pretende realizar la modelación de las variables de costo y gasto de ventas (también considerando la variante en las diferencias de las variables por periodo), la matriz de correlación es un buen indicador para observar relaciones lineales existentes en las variables. En particular, vemos para el caso de la información de gastos, una “fuerte” correlación de las variables de costo, diferencia de costos y diferencia de ventas. Para este caso, es natural encontrar una correlacion positiva con dichas variables, pues es claro que costos y gastos están asociados entre sí. Igualmente, la variable de diferencia de gastos, fue calculada con la variable gastos, por lo tanto tiene sentido encontrar esta correlación. Por otro lado, tanto para la variable de ventas como gastos, no se ven correlaciones fuertes en relación a las variables macro-económicas, lo que nos indica que no existe una relación lineal entre esta variable y las demás. Por lo que una buena alternativa en este trabajo, será considerar transformaciones no lineales de las variables para encontrar una dependencia con la información de los costos de venta. Ahora, mirando las variables de diferencia de gastos y costos, vemos que existen dependencias lineales mayores con las variables macroeconómicas a diferencia de las variables originales, así vemos que la diferencia en costos tiene un grado de asociación con todas las variables macroeconomicas, mientras que los gastos presenta una relación lineal con el balance de cuenta corriente, por lo que se podría pensar que existen relaciones no lineales respecto a los otros indicadores económicos.
pairs(data,diag.panel = panel.hist, lower.panel = panel.cor)
### Funcion para encontrar los contornos
c_alpha = function(alpha, sigma, p){
res = (2*pi)^(-p/2)*(det(sigma))^(-1/2)*exp(-1/2*qchisq(1-alpha, df = p))
return(res)
}
grafica = function(data, name1, name2){
data_aux = data[c(name1,name2)]
names(data_aux) = c("y1","y2")
cov_data = cov(data_aux)
mean_data = mean=colMeans(data_aux)
min_value1 = min(data[name1])
max_value1 = max(data[name1])
min_value2 = min(data[name2])
max_value2 = max(data[name2])
n = 100
y1 = seq(min_value1, max_value1, length.out = n)
y2 = seq(min_value2, max_value2, length.out = n)
grid = expand.grid(y1,y2)
grid$Z<-apply(grid,1,dmvnorm,mean = mean_data,sigma=cov_data)
Z<-matrix(grid$Z,nrow=n,ncol=n)
contornos = sapply(c(0.01, 0.05, 0.1), c_alpha, sigma = cov_data, 2)
contour(y1,y2,Z,levels=contornos,labels=c("99%","95%","90%"),
las=1)
points(data_aux$y1,data_aux$y2)
grid()
title(main = "Contornos de distribucion normal", xlab = name1, ylab = name2)
}
p1 = grafica(data, "Costo.de.ventas_dif", "PIB")
p2 = grafica(data, "Costo.de.ventas_dif", "TRM")
p3 = grafica(data, "Costo.de.ventas" , "Costo.de.ventas_dif")
p4 = grafica(data, "Gastos.de.ventas" , "Gastos.de.ventas_dif")
p4 = grafica(data, "Costo.de.ventas_dif" , "Gastos.de.ventas_dif")
data_aux = select(all_data,select = -starts_with('NIT'))
data_aux = select(data_aux,select = -starts_with('Year'))
### Transformacion de las variables respuesta
### Recordar para la interpretacion de los modelos:
### regresion log(y) = b*log(x) -> cambio en x, es un aumento en b% en y
### regresion log(y) = b*x -> cambio en x implica un aumento en 100*b puntos en y
### regresion y = b*log(x) -> cambio en x implica un cambio de (b/100)% en y
### regresion y = b*x -> cambio en x implica un aumento de b en y
### Transformacion 1: a nivel logaritmico
data_aux$Costo.de.ventas_dif = log(1 + all_data$Costo.de.ventas_dif)
data_aux$PIB = log(1 + all_data$PIB)
data_aux$TRM = log(1 + all_data$TRM)
data_aux$Desempleo = log(1 + all_data$Desempleo)
data_aux$Balance_CC = log(1 + all_data$Balance_CC)
data_aux$Balance_Fiscal = log(1 + all_data$Balance_Fiscal)
data_aux$Inflacion = log(1 + all_data$Inflacion)
data_aux$Tasa_Intervencion = log(1 + all_data$Tasa_Intervencion)
### Transformacion 2: log(costos sobre gastos)
#data_aux$Costo.de.ventas_dif = log(all_data$Costo.de.ventas/all_data$Gastos.de.ventas)
### Transformacion 3: differencia porcentual de costos
#data_aux$Costo.de.ventas_dif = all_data$Costo.de.ventas_dif
### Transformacion boxcox: Realiza una transformacion para obtener un comportamiento
### de la distribucion normal de la variable
#bx = boxcox(all_data$Costo.de.ventas,objective.name = "Log-Likelihood", optimize = TRUE)
#lambda = bx$lambda
#data_aux$Costo.de.ventas_dif = (data_aux$Costo.de.ventas^lambda - 1)/lambda
empresas_train = c(800015615, 800045720,
800081030, 800112440,
800118660, 800157469,
800232356, 800236890,
801002644, 805012368,
806014553, 830030574,
830037495, 860009694,
860033653, 860050956,
890909034, 900173460,
900184722, 900204182,
900364670, 900378893)
empresas_test = c(830052054, 860030360,
860501682, 890117431,
890300012, 890311366,
890904459, 890929951,
900234565, 900389088,
900437650)
train = all_data$NIT%in%empresas_train
test = all_data$NIT%in%empresas_test
NIT_train = NIT[train,]
NIT_test = NIT[test,]
data_train = data_aux[train,]
rownames(data_train) <- NULL
data_train_z = data_train#scale(data_train, center = TRUE, scale = TRUE)
media_tr = attr(data_train_z, 'scaled:center')
stdev_tr = attr(data_train_z, 'scaled:scale')
data_train_z = as.data.frame(data_train_z)
data_test = data_aux[test,]
rownames(data_test) <- NULL
data_test_z = data_test#as.data.frame(scale(data_test, center = media_tr, scale = stdev_tr))
data_train_z$NIT = NIT_train
data_test_z$NIT = NIT_test
r2_score <- function(x, y) summary(lm(y~x))$r.squared
adj_r2_score <- function(x, y) summary(lm(y~x))$adj.r.squared
mod_lin = lm('Costo.de.ventas_dif~PIB+TRM+Desempleo+Inflacion+Tasa_Intervencion+Balance_CC+Balance_Fiscal', data = data_train_z)
summary(mod_lin)
##
## Call:
## lm(formula = "Costo.de.ventas_dif~PIB+TRM+Desempleo+Inflacion+Tasa_Intervencion+Balance_CC+Balance_Fiscal",
## data = data_train_z)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.54739 -0.01803 0.08434 0.20113 0.80049
##
## Coefficients: (5 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.88054 2.54915 -0.345 0.731
## PIB 11.40714 38.26372 0.298 0.767
## TRM 0.07671 1.97183 0.039 0.969
## Desempleo NA NA NA NA
## Inflacion NA NA NA NA
## Tasa_Intervencion NA NA NA NA
## Balance_CC NA NA NA NA
## Balance_Fiscal NA NA NA NA
##
## Residual standard error: 0.4606 on 63 degrees of freedom
## Multiple R-squared: 0.007436, Adjusted R-squared: -0.02407
## F-statistic: 0.236 on 2 and 63 DF, p-value: 0.7905
En el conjunto de entrenamiento:
preds = predict(mod_lin)
plot(preds, data_train_z$Costo.de.ventas_dif, xlab = 'Valor predicho', ylab = 'Valor Real',
main='Modelo Lineal General')
abline(a=0, b=1, lwd = 2, col = 'red')
En el conjunto de Prueba
preds_test = predict(mod_lin, newdata = data_test_z)
## Warning in stats::predict.lm(object, ...): prediction from a rank-deficient fit
## may be misleading
r2_model<-r2_score(preds_test, data_test_z$Costo.de.ventas_dif)
adj_r2_model<-adj_r2_score(preds_test, data_test_z$Costo.de.ventas_dif)
sub_tit = paste("R2", format(r2_model, digits=2, nsmall=2),
"; R2_adj", format(adj_r2_model, digits=2, nsmall=2),
sep = " ", collapse = NULL)
plot(preds_test, data_test_z$Costo.de.ventas_dif, xlab = 'Valor predicho', ylab = 'Valor Real',
main='Modelo Lineal General', sub=sub_tit)
abline(a=0, b=1, lwd = 2, col = 'red')
par(mfrow=c(3,2))
mod_plot = plot(mod_lin, which = c(1:6))
## hat values (leverages) are all = 0.04545455
## and there are no factor predictors; no plot no. 5
,
De los gráficos anteriores, en particular analizando el valor de la distancia de Cook para las observaciones, notamos que las observaciones 17, 30, 52 son candidatas a ser registros atípicos en el conjunto de datos, por lo que entrenaremos un nuevo modelo eliminando estos registros. Notar que los outliers corresponden a la empresa con NIT 890909034 para el 2016, y para la empresa 800236890 en los periodos del 2017 y 2018, información que se contrasta con los outliers obtenidos en el boxplot, lo cual están incluidos tanto mirando la variable de diferencia costos de venta.En vista de su comportamiento raro en magnitud según el boxplot, no es de extrañarse que estos registros hayan sido aquellos con la distancia de cook mas grande. Procederemos a entrenar un modelo removiendo estos registros
### Vector para eliminar registros atipicos según la información obtenida por la distancia de cook
outliers = c(17, 30, 52)
data_train_z_noOut = data_train_z[-outliers,]
h_ii<-hatvalues(mod_lin)
plot(hatvalues(mod_lin),las=1,xlab="i",ylab="hii",main="Influencia (h_ii)",type="h")
### Inflacion de la varianza
#vif(mod_lin)
mod_lin02 = lm('Costo.de.ventas_dif~PIB+TRM+Desempleo+Inflacion+Tasa_Intervencion+Balance_CC+Balance_Fiscal', data = data_train_z_noOut)
summary(mod_lin02)
##
## Call:
## lm(formula = "Costo.de.ventas_dif~PIB+TRM+Desempleo+Inflacion+Tasa_Intervencion+Balance_CC+Balance_Fiscal",
## data = data_train_z_noOut)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.83087 -0.07811 0.01502 0.11082 0.72035
##
## Coefficients: (5 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.2282 1.2249 -1.819 0.0739 .
## PIB 32.8112 18.3858 1.785 0.0794 .
## TRM -0.7627 0.9475 -0.805 0.4240
## Desempleo NA NA NA NA
## Inflacion NA NA NA NA
## Tasa_Intervencion NA NA NA NA
## Balance_CC NA NA NA NA
## Balance_Fiscal NA NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2162 on 60 degrees of freedom
## Multiple R-squared: 0.08571, Adjusted R-squared: 0.05523
## F-statistic: 2.812 on 2 and 60 DF, p-value: 0.068
En el conjunto de entrenamiento:
preds = predict(mod_lin02)
plot(preds, data_train_z_noOut$Costo.de.ventas_dif, xlab = 'Valor predicho', ylab = 'Valor Real')
abline(a=0, b=1, lwd = 2, col = 'red')
En el conjunto de Prueba
preds_test = predict(mod_lin02, newdata = data_test_z)
## Warning in stats::predict.lm(object, ...): prediction from a rank-deficient fit
## may be misleading
r2_model<-r2_score(preds_test, data_test_z$Costo.de.ventas_dif)
adj_r2_model<-adj_r2_score(preds_test, data_test_z$Costo.de.ventas_dif)
sub_tit = paste("R2", format(r2_model, digits=2, nsmall=2),
"; R2_adj", format(adj_r2_model, digits=2, nsmall=2),
sep = " ", collapse = NULL)
plot(preds_test, data_test_z$Costo.de.ventas_dif, xlab = 'Valor predicho', ylab = 'Valor Real',
main='Modelo Lineal General', sub=sub_tit)
abline(a=0, b=1, lwd = 2, col = 'red')
par(mfrow=c(3,2))
mod_plot = plot(mod_lin02, which = c(1:6))
## hat values (leverages) are all = 0.04761905
## and there are no factor predictors; no plot no. 5
Al observar el desempeño del modelo sin considerar dichos registros raros, no se tiene una mejora significativa en el modelo.
Vamos a encontrar el parametro de regulairzacion
library(glmnet)
## Warning: package 'glmnet' was built under R version 3.6.3
## Loaded glmnet 3.0-2
f1 = formula('Costo.de.ventas_dif~-1+PIB+TRM+Desempleo+Inflacion+Tasa_Intervencion+Balance_CC+Balance_Fiscal')
X = model.matrix(f1, data = as.data.frame(data_train_z))
Y = data_train_z$Costo.de.ventas_dif
lambda_grid = 10^seq(10,-2,length.out = 100)
modelo_regularizacion = cv.glmnet(x = X, y = Y, lambda = lambda_grid)
plot(modelo_regularizacion)
Entrenamos el modelo agregando el parametro de regularizacion, y asi ver relevancia de variables
mod_lin_reg = glmnet(x = X, y = Y, lambda = 0.05, alpha = 1, intercept = FALSE)
coef(mod_lin_reg)
## 8 x 1 sparse Matrix of class "dgCMatrix"
## s0
## (Intercept) .
## PIB .
## TRM .
## Desempleo -1.170064
## Inflacion .
## Tasa_Intervencion .
## Balance_CC .
## Balance_Fiscal .
Dentro de los modelos que fueron expuestos a lo largo del curso, se encuentra la familia de los modelos lineales generalizados, los cual nos permiten la creación de modelos teniendo en cuenta diferentes supuestos que se hacen sobre la variable respuesta que estamos considerando. En la elaboración de este trabajo, se está considerando realiza un modelo de predicción sobre transformaciones en la diferencia relativa de los costos de ventas que tienen las empresas, por lo que el dominio de la variable son los números reales (ya que puede tomar valores continuos tanto positivos como negativos, los cuales son considerados en las diferentes transformaciones que se plantean). Justo por la caracteristica de la variable respuesta que tenemos, no se considera pertinente realizar evaluacion de los modelos, esta conclusión está apoyada del análisis que se realiza de los diferentes modelos generalizados que podriamos considerar:
Poisson: Para este modelo, esperamos que la variable respuesta tenga la forma de conteos, no negativa. Por lo que la diferencia de los costos de venta no aplica para este modelo.
Logit: Este es un modelo logistico, el cual asume que la variable respuesta tendrá un comportamiento dentro del intervalo (0,1) el cual se utiliza para la predicción de la ocurrencia de un evento (ocurre o no ocurre), por lo que tampoco se ajusta para el modelamiento de la diferencia de costos de venta
Gamma y Gaussiana inversa: De las distribuciones de probabilidad de la función gamma y gaussiana inversa, se sabe que los valores de la variable pueden ser continuos, por lo que nos llevaría a pensar de forma inicial que alguno de estos se puede considerar, pero en vista que tienen otra testricción, y es que los valores son continuos positivos, la variable de diferencia de costo de ventas tampoco se podría modelar con este tipo de modelos, ya que puede tomar valores negativos
Gaussiana: Por la caracteristica de la distribución, sabemos que es posible modelar variables respuesta que su dominio sea los números reales, por lo que la variable de diferencia de costos de venta encaja en este tipo de modelo, ahora bien, esto es equivalente a considerar el modelo lineal general presentado anteriormente.
Por el análisis realizado, no se considera pertinente utilizar alguno de los otros modelos lineales generalizados para el modela miento de la variable transformada de diferencia relativa de costos de venta
mod_me = lmer('Costo.de.ventas_dif~Desempleo+PIB+(0+Desempleo|NIT)+(PIB|NIT)', data = data_train_z)
summary(mod_me)
## Linear mixed model fit by REML ['lmerMod']
## Formula: Costo.de.ventas_dif ~ Desempleo + PIB + (0 + Desempleo | NIT) +
## (PIB | NIT)
## Data: data_train_z
##
## REML criterion at convergence: 68.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -5.2577 -0.0832 0.1859 0.3549 2.5374
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## NIT Desempleo 3.576169 1.89108
## NIT.1 (Intercept) 0.004193 0.06475
## PIB 0.566302 0.75253 -1.00
## Residual 0.182955 0.42773
## Number of obs: 66, groups: NIT, 22
##
## Fixed effects:
## Estimate Std. Error t value
## (Intercept) -0.8466 3.0990 -0.273
## Desempleo -1.2765 30.4740 -0.042
## PIB 12.6315 17.3072 0.730
##
## Correlation of Fixed Effects:
## (Intr) Desmpl
## Desempleo -0.926
## PIB -0.473 0.107
par(mfrow=c(3,2))
plot(mod_me, which = c(1:6))
preds = predict(mod_me)
plot(preds,data_train_z$Costo.de.ventas_dif, main='Modelo de Efectos Mixtos')
abline(a=0, b=1, lwd = 2, col = 'red')
preds = predict(mod_me, newdata = data_test_z,allow.new.levels=TRUE)
r2_model<-r2_score(preds, data_test_z$Costo.de.ventas_dif)
adj_r2_model<-adj_r2_score(preds, data_test_z$Costo.de.ventas_dif)
sub_tit = paste("R2", format(r2_model, digits=2, nsmall=2),
"; R2_adj", format(adj_r2_model, digits=2, nsmall=2),
sep = " ", collapse = NULL)
plot(preds,data_test_z$Costo.de.ventas_dif, main='Modelo de Efectos Mixtos', sub=sub_tit)
abline(a=0, b=1, lwd = 2, col = 'red')
Desafortunadamente en el caso de prueba no se logra distinguir la tendencia natural en el comportamiento de la diferencia de los costos de venta y la escala se encuentra muy distante entre los valores predichos y los reales, como se espera desde el gráfico anterior. En esta evaluación los valores predichos se ponderan para generar una tendencia casi constante y la razonabilidad una vez más se pone en duda, aunque no por completo, dado que éstos valores efectivamente pueden ser alcanzados con condiciones ligeramente diferentes.
Desempleo = seq(min(data_train_z$Desempleo),max(data_train_z$Desempleo), length.out = 50)
PIB = seq(min(data_train_z$PIB),max(data_train_z$PIB), length.out = 50)
data_surface = expand.grid(Desempleo,PIB)
names(data_surface) = c('Desempleo','PIB')
data_surface$NIT = 1000
z = predict(mod_me, newdata = data_surface,allow.new.levels=TRUE)
z = matrix(z, nrow = 50, ncol = 50)
### Toca rotar la figura para poder ver el plano
fig <- plot_ly(x = PIB, y = Desempleo, z = z) %>% add_surface()
fig
Desempleo = seq(min(data_train_z$Desempleo),max(data_train_z$Desempleo), length.out = 50)
PIB = seq(min(data_train_z$PIB),max(data_train_z$PIB), length.out = 50)
data_surface = expand.grid(Desempleo,PIB)
names(data_surface) = c('Desempleo','PIB')
data_surface$NIT = 800015615
z2 = predict(mod_me, newdata = data_surface)
z2 = matrix(z2, nrow = 50, ncol = 50)
### Toca rotar la figura para poder ver el plano
fig %>% add_surface(z = ~z2, opacity = 0.98,colorscale = list(c(0,1),c("rgb(255,112,184)","rgb(120,0,64)"))) %>% layout(title="Poblacional (azul y verde) vs Un Individuo (Rosa)")
#fig <- plot_ly(x = PIB, y = Desempleo, z = z) %>% add_surface()
#fig
## Generalized linear model Lasso
glm_obj <- glmmLasso(Costo.de.ventas_dif~TRM+PIB+Desempleo+Inflacion+Balance_CC+Balance_Fiscal+Tasa_Intervencion, rnd = list(NIT=~1+PIB), data = data_train_z, lambda=1.6, family = gaussian(link ="identity"))
## Warning in est.glmmLasso.RE(fix = fix, rnd = rnd, data = data, lambda =
## lambda, : Cluster variable should be specified as a factor variable!
## Warning in est.glmmLasso.RE(fix = fix, rnd = rnd, data = data, lambda =
## lambda, : Random slopes are not standardized back!
summary(glm_obj)
## Call:
## glmmLasso(fix = Costo.de.ventas_dif ~ TRM + PIB + Desempleo +
## Inflacion + Balance_CC + Balance_Fiscal + Tasa_Intervencion,
## rnd = list(NIT = ~1 + PIB), data = data_train_z, lambda = 1.6,
## family = gaussian(link = "identity"))
##
##
## Fixed Effects:
##
## Coefficients:
## Estimate StdErr z.value p.value
## (Intercept) -0.298403 NA NA NA
## TRM 0.000000 NA NA NA
## PIB 2.867850 NA NA NA
## Desempleo 0.000000 NA NA NA
## Inflacion 0.000000 NA NA NA
## Balance_CC 0.000000 NA NA NA
## Balance_Fiscal 0.013849 NA NA NA
## Tasa_Intervencion 0.000000 NA NA NA
##
## Random Effects:
##
## StdDev:
## NIT NIT:PIB
## NIT 0.0313817343 0.0003120996
## NIT:PIB 0.0003120996 0.0287113789
preds = predict(glm_obj, data = data_train_z)
plot(preds,data_train_z$Costo.de.ventas_dif, main='Generalized linear model Lasso')
abline(a=0, b=1, lwd = 2, col = 'red')
Bajo esta aplicación del modelo Lasso es claro como ya se presenta una mejor distribución de los valores predichos contra los reales y éste es un comportamiento más natural y razonable en la industria, donde si bien hay un par que se alejan del común respecto a las diferencias en los costos de venta, el resto dentro de sus segmentos también puede tener distribuciones similares teniendo en cuenta sus montos.
| Medidas | Resultados |
|---|---|
| r2 train | 0.4524102 |
| r2 adj train | 0.4438542 |
| mse train | 0.1847248 |
| Medidas | Resultados |
|---|---|
| r2 test | 0.0110409 |
| r2 adj test | -0.0208610 |
| mse test | 0.1768833 |
Como se presenta a continuación en esta oportunidad se captura algo de la relación positiva entre los valores predichos y los reales. Exceptuando los valores atipicos la razonabilidad se pone en duda debido al sentido de los signos y la propensión de éstos modelos a entregar resultados en escalas menores a las esperadas.
infl <- influence(mod_me, obs = TRUE)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00327672 (tol = 0.002, component 1)
## boundary (singular) fit: see ?isSingular
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00246706 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00448398 (tol = 0.002, component 1)
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00501265 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00945264 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00405749 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00602556 (tol = 0.002, component 1)
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00347125 (tol = 0.002, component 1)
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.0119194 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00267079 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.0142854 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.0155401 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00314626 (tol = 0.002, component 1)
## boundary (singular) fit: see ?isSingular
## boundary (singular) fit: see ?isSingular
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00745265 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## boundary (singular) fit: see ?isSingular
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.0101187 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00213272 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.0322785 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00236114 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00264946 (tol = 0.002, component 1)
## boundary (singular) fit: see ?isSingular
## boundary (singular) fit: see ?isSingular
## boundary (singular) fit: see ?isSingular
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00289387 (tol = 0.002, component 1)
## boundary (singular) fit: see ?isSingular
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00363913 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00307108 (tol = 0.002, component 1)
cooks.distance(infl)
## [,1]
## 1 5.018443e-04
## 2 9.089068e-04
## 3 8.314192e-03
## 4 1.117800e-04
## 5 7.408665e-05
## 6 1.757706e-03
## 7 2.116672e-04
## 8 7.376441e-01
## 9 7.368845e-03
## 10 1.825278e-05
## 11 7.601447e-03
## 12 5.310722e-04
## 13 5.446871e-03
## 14 3.948588e-04
## 15 6.556617e-04
## 16 1.538171e-05
## 17 2.599058e-01
## 18 9.183001e-03
## 19 1.299828e-03
## 20 7.821451e-04
## 21 7.267041e-04
## 22 6.456379e-03
## 23 9.426501e-04
## 24 2.714813e-03
## 25 4.347949e-05
## 26 6.154389e-04
## 27 3.050014e-03
## 28 3.321453e-05
## 29 1.206060e-03
## 30 5.470376e-02
## 31 6.854345e-03
## 32 3.267427e-03
## 33 2.906183e-03
## 34 1.435671e-03
## 35 7.678562e-03
## 36 2.740473e-04
## 37 2.204242e-03
## 38 1.231177e-04
## 39 4.066242e-02
## 40 2.185680e-03
## 41 2.784577e-04
## 42 4.201332e-04
## 43 1.276700e-04
## 44 4.654026e-04
## 45 3.079188e-03
## 46 1.400033e-05
## 47 1.621169e-03
## 48 5.265028e-03
## 49 2.080495e-03
## 50 3.546338e-03
## 51 2.329566e-03
## 52 1.071022e+00
## 53 9.307713e-05
## 54 5.639236e-03
## 55 8.465839e-03
## 56 2.622994e-04
## 57 2.580200e-04
## 58 5.902522e-03
## 59 9.856006e-04
## 60 1.614255e-05
## 61 5.599065e-03
## 62 1.495921e-03
## 63 2.076282e-04
## 64 9.095804e-04
## 65 5.779353e-03
## 66 7.248648e-04
plot(infl, which = "cook")
plot(all_data$Year, all_data$Costo.de.ventas, col=all_data$NIT,
xlab = "Año", ylab = "Valor del Costo de Venta por Empresa")
## Generalized linear model Lasso quitando empresa outlier
data_train_z_sinoutl = data_train_z[-c(8, 30, 52), ]
glm_obj_s <- glmmLasso(Costo.de.ventas_dif~TRM+PIB+Balance_CC+Desempleo+Balance_Fiscal, rnd = list(NIT=~1+PIB+Desempleo), data = data_train_z_sinoutl, lambda=2, family = gaussian(link ="identity"))
## Warning in est.glmmLasso.RE(fix = fix, rnd = rnd, data = data, lambda =
## lambda, : Cluster variable should be specified as a factor variable!
## Warning in est.glmmLasso.RE(fix = fix, rnd = rnd, data = data, lambda =
## lambda, : Random slopes are not standardized back!
summary(glm_obj_s)
## Call:
## glmmLasso(fix = Costo.de.ventas_dif ~ TRM + PIB + Balance_CC +
## Desempleo + Balance_Fiscal, rnd = list(NIT = ~1 + PIB + Desempleo),
## data = data_train_z_sinoutl, lambda = 2, family = gaussian(link = "identity"))
##
##
## Fixed Effects:
##
## Coefficients:
## Estimate StdErr z.value p.value
## (Intercept) -0.057729 NA NA NA
## TRM -0.306162 NA NA NA
## PIB 0.000000 NA NA NA
## Balance_CC -0.051623 NA NA NA
## Desempleo 0.000000 NA NA NA
## Balance_Fiscal 0.000000 NA NA NA
##
## Random Effects:
##
## StdDev:
## NIT NIT:PIB NIT:Desempleo
## NIT 0.0550191872 -0.0001415357 -0.0004735195
## NIT:PIB -0.0001415357 0.0544096640 -0.0025104956
## NIT:Desempleo -0.0004735195 -0.0025104956 0.0546813112
preds = predict(glm_obj_s, data = data_train_z_sinoutl)
plot(preds,data_train_z_sinoutl$Costo.de.ventas_dif, main='Generalized linear model Lasso without outliers')
abline(a=0, b=1, lwd = 2, col = 'red')
Aplicando la remoción de outliers la distribución hacia el centro de los datos se extiende más y esto es deseado, y la escala no se ve demasiado afectada por la corrección. En términos de mercado esta clase de resultados es la más natural y razonable entre todas, donde es claro como los indicadores macro-economicos pueden afectar de manera diferente a cada componente que representa la industria.
| Medidas | Resultados |
|---|---|
| r2 train | 0.6129632 |
| r2 adj train | -0.6066183 |
| mse train | 0.0679348 |
preds = predict(glm_obj_s, newdata = data_test_z)
r2_model<-r2_score(preds, data_test_z$Costo.de.ventas_dif)
adj_r2_model<-adj_r2_score(preds, data_test_z$Costo.de.ventas_dif)
mse_model<-mean((data_test_z$Costo.de.ventas_dif - preds)^2)
sub_tit = paste("R2", format(r2_model, digits=2, nsmall=2),
"; R2_adj", format(adj_r2_model, digits=2, nsmall=2),
sep = " ", collapse = NULL)
plot(preds,data_test_z$Costo.de.ventas_dif, main='Generalized linear model Lasso without outliers', sub = sub_tit)
abline(a=0, b=1, lwd = 2, col = 'red')
Probando con el conjunto de testeo puede verse en comparación al resultado en test del modelo anterior que la distorsión se evidencia hacia los valores mayores en el conjunto predicho y el sentido de los signos, lo que le reduce razonabilidad. Sobre el efecto de escala éste se esperaba dado el resultado en el set de entrenamiento.
| Medidas | Resultados |
|---|---|
| r2 test | 0.0348412 |
| r2 adj test | 0.0037070 |
| mse test | 0.1734217 |
## Transformacion de variables (productos y divisiones)
vars = c("TRM","PIB","Desempleo","Inflacion","Tasa_Intervencion","Balance_CC","Balance_Fiscal")
df = data_train_z[vars]
# x^2
df_p <- df^2
vector = c()
for (i in colnames(df)) vector <- c(vector, paste(i,'_p_',i, sep = ''))
colnames(df_p) <- vector
# xi*xj
df_s <- do.call(cbind,combn(colnames(df), 2,
FUN= function(x) list(df[x[1]]*df[x[2]])))
colnames(df_s) <- combn(colnames(df), 2,
FUN = paste, collapse="_p_")
# xi/xj
df_t <- do.call(cbind,combn(colnames(df), 2,
FUN= function(x) list(df[x[1]]/df[x[2]])))
colnames(df_t) <- combn(colnames(df), 2,
FUN = paste, collapse="_d_")
df_trans=cbind(data_train_z,df_p,df_s,df_t)
## Generalized linear model Lasso con todas las transformaciones
glm_obj <- glmmLasso(Costo.de.ventas_dif~TRM+PIB+Desempleo+Inflacion+Tasa_Intervencion+Balance_CC+Balance_Fiscal+TRM_p_TRM+PIB_p_PIB+Desempleo_p_Desempleo+Inflacion_p_Inflacion+Tasa_Intervencion_p_Tasa_Intervencion+Balance_CC_p_Balance_CC+Balance_Fiscal_p_Balance_Fiscal+TRM_p_PIB+TRM_p_Desempleo+TRM_p_Inflacion+TRM_p_Tasa_Intervencion+TRM_p_Balance_CC+TRM_p_Balance_Fiscal+PIB_p_Desempleo+PIB_p_Inflacion+PIB_p_Tasa_Intervencion+PIB_p_Balance_CC+PIB_p_Balance_Fiscal+Desempleo_p_Inflacion+Desempleo_p_Tasa_Intervencion+Desempleo_p_Balance_CC+Desempleo_p_Balance_Fiscal+Inflacion_p_Tasa_Intervencion+Inflacion_p_Balance_CC+Inflacion_p_Balance_Fiscal+Tasa_Intervencion_p_Balance_CC+Tasa_Intervencion_p_Balance_Fiscal+Balance_CC_p_Balance_Fiscal+TRM_d_PIB+TRM_d_Desempleo+TRM_d_Inflacion+TRM_d_Tasa_Intervencion+TRM_d_Balance_CC+TRM_d_Balance_Fiscal+PIB_d_Desempleo+PIB_d_Inflacion+PIB_d_Tasa_Intervencion+PIB_d_Balance_CC+PIB_d_Balance_Fiscal+Desempleo_d_Inflacion+Desempleo_d_Tasa_Intervencion+Desempleo_d_Balance_CC+Desempleo_d_Balance_Fiscal+Inflacion_d_Tasa_Intervencion+Inflacion_d_Balance_CC+Inflacion_d_Balance_Fiscal+Tasa_Intervencion_d_Balance_CC+Tasa_Intervencion_d_Balance_Fiscal+Balance_CC_d_Balance_Fiscal, rnd = list(NIT=~1+PIB+Balance_CC), data = df_trans, lambda=2.55, family = gaussian(link ="identity"))
## Warning in est.glmmLasso.RE(fix = fix, rnd = rnd, data = data, lambda =
## lambda, : Cluster variable should be specified as a factor variable!
## Warning in est.glmmLasso.RE(fix = fix, rnd = rnd, data = data, lambda =
## lambda, : Random slopes are not standardized back!
summary(glm_obj)
## Call:
## glmmLasso(fix = Costo.de.ventas_dif ~ TRM + PIB + Desempleo +
## Inflacion + Tasa_Intervencion + Balance_CC + Balance_Fiscal +
## TRM_p_TRM + PIB_p_PIB + Desempleo_p_Desempleo + Inflacion_p_Inflacion +
## Tasa_Intervencion_p_Tasa_Intervencion + Balance_CC_p_Balance_CC +
## Balance_Fiscal_p_Balance_Fiscal + TRM_p_PIB + TRM_p_Desempleo +
## TRM_p_Inflacion + TRM_p_Tasa_Intervencion + TRM_p_Balance_CC +
## TRM_p_Balance_Fiscal + PIB_p_Desempleo + PIB_p_Inflacion +
## PIB_p_Tasa_Intervencion + PIB_p_Balance_CC + PIB_p_Balance_Fiscal +
## Desempleo_p_Inflacion + Desempleo_p_Tasa_Intervencion + Desempleo_p_Balance_CC +
## Desempleo_p_Balance_Fiscal + Inflacion_p_Tasa_Intervencion +
## Inflacion_p_Balance_CC + Inflacion_p_Balance_Fiscal + Tasa_Intervencion_p_Balance_CC +
## Tasa_Intervencion_p_Balance_Fiscal + Balance_CC_p_Balance_Fiscal +
## TRM_d_PIB + TRM_d_Desempleo + TRM_d_Inflacion + TRM_d_Tasa_Intervencion +
## TRM_d_Balance_CC + TRM_d_Balance_Fiscal + PIB_d_Desempleo +
## PIB_d_Inflacion + PIB_d_Tasa_Intervencion + PIB_d_Balance_CC +
## PIB_d_Balance_Fiscal + Desempleo_d_Inflacion + Desempleo_d_Tasa_Intervencion +
## Desempleo_d_Balance_CC + Desempleo_d_Balance_Fiscal + Inflacion_d_Tasa_Intervencion +
## Inflacion_d_Balance_CC + Inflacion_d_Balance_Fiscal + Tasa_Intervencion_d_Balance_CC +
## Tasa_Intervencion_d_Balance_Fiscal + Balance_CC_d_Balance_Fiscal,
## rnd = list(NIT = ~1 + PIB + Balance_CC), data = df_trans,
## lambda = 2.55, family = gaussian(link = "identity"))
##
##
## Fixed Effects:
##
## Coefficients:
## Estimate StdErr z.value p.value
## (Intercept) -0.138383 NA NA NA
## TRM 0.000000 NA NA NA
## PIB 0.000000 NA NA NA
## Desempleo 0.000000 NA NA NA
## Inflacion 0.000000 NA NA NA
## Tasa_Intervencion 0.000000 NA NA NA
## Balance_CC 0.000000 NA NA NA
## Balance_Fiscal 0.000000 NA NA NA
## TRM_p_TRM 0.000000 NA NA NA
## PIB_p_PIB 1.833788 NA NA NA
## Desempleo_p_Desempleo 0.000000 NA NA NA
## Inflacion_p_Inflacion 0.000000 NA NA NA
## Tasa_Intervencion_p_Tasa_Intervencion 0.012333 NA NA NA
## Balance_CC_p_Balance_CC 0.000000 NA NA NA
## Balance_Fiscal_p_Balance_Fiscal 0.000000 NA NA NA
## TRM_p_PIB 0.000000 NA NA NA
## TRM_p_Desempleo 0.000000 NA NA NA
## TRM_p_Inflacion 0.000000 NA NA NA
## TRM_p_Tasa_Intervencion 0.000000 NA NA NA
## TRM_p_Balance_CC 0.000000 NA NA NA
## TRM_p_Balance_Fiscal 0.000000 NA NA NA
## PIB_p_Desempleo 0.000000 NA NA NA
## PIB_p_Inflacion 0.000000 NA NA NA
## PIB_p_Tasa_Intervencion 0.000000 NA NA NA
## PIB_p_Balance_CC 0.000000 NA NA NA
## PIB_p_Balance_Fiscal 0.000000 NA NA NA
## Desempleo_p_Inflacion 0.000000 NA NA NA
## Desempleo_p_Tasa_Intervencion 0.000000 NA NA NA
## Desempleo_p_Balance_CC 0.000000 NA NA NA
## Desempleo_p_Balance_Fiscal 0.000000 NA NA NA
## Inflacion_p_Tasa_Intervencion 0.000000 NA NA NA
## Inflacion_p_Balance_CC 0.000000 NA NA NA
## Inflacion_p_Balance_Fiscal 0.000000 NA NA NA
## Tasa_Intervencion_p_Balance_CC 0.000000 NA NA NA
## Tasa_Intervencion_p_Balance_Fiscal 0.000000 NA NA NA
## Balance_CC_p_Balance_Fiscal 0.000000 NA NA NA
## TRM_d_PIB 0.000000 NA NA NA
## TRM_d_Desempleo 0.000000 NA NA NA
## TRM_d_Inflacion 0.000000 NA NA NA
## TRM_d_Tasa_Intervencion 0.000000 NA NA NA
## TRM_d_Balance_CC 0.000000 NA NA NA
## TRM_d_Balance_Fiscal 0.000000 NA NA NA
## PIB_d_Desempleo 0.000000 NA NA NA
## PIB_d_Inflacion 0.000000 NA NA NA
## PIB_d_Tasa_Intervencion 0.000000 NA NA NA
## PIB_d_Balance_CC 0.000000 NA NA NA
## PIB_d_Balance_Fiscal 0.000000 NA NA NA
## Desempleo_d_Inflacion 0.000000 NA NA NA
## Desempleo_d_Tasa_Intervencion 0.000000 NA NA NA
## Desempleo_d_Balance_CC 0.000000 NA NA NA
## Desempleo_d_Balance_Fiscal 0.000000 NA NA NA
## Inflacion_d_Tasa_Intervencion 0.000000 NA NA NA
## Inflacion_d_Balance_CC 0.000000 NA NA NA
## Inflacion_d_Balance_Fiscal 0.000000 NA NA NA
## Tasa_Intervencion_d_Balance_CC 0.000000 NA NA NA
## Tasa_Intervencion_d_Balance_Fiscal 0.000000 NA NA NA
## Balance_CC_d_Balance_Fiscal 0.000000 NA NA NA
##
## Random Effects:
##
## StdDev:
## NIT NIT:PIB NIT:Balance_CC
## NIT 0.0275646575 0.0003524452 0.001141849
## NIT:PIB 0.0003524452 0.0248494334 0.000811444
## NIT:Balance_CC 0.0011418491 0.0008114440 0.028141991
### Para que converja, toca poner un lamba alto. Esto conlleva a que todas las betas sean 0
### Un lambda menor lleva a que la matriz no sea invertible
## Generalized linear model Lasso
glm_obj_tr <- glmmLasso(Costo.de.ventas_dif~PIB+TRM+Balance_Fiscal, rnd = list(NIT=~1+PIB+TRM+Balance_Fiscal), data = df_trans, lambda=0.1, family = gaussian(link ="identity"))
## Warning in est.glmmLasso.RE(fix = fix, rnd = rnd, data = data, lambda =
## lambda, : Cluster variable should be specified as a factor variable!
## Warning in est.glmmLasso.RE(fix = fix, rnd = rnd, data = data, lambda =
## lambda, : Random slopes are not standardized back!
summary(glm_obj_tr)
## Call:
## glmmLasso(fix = Costo.de.ventas_dif ~ PIB + TRM + Balance_Fiscal,
## rnd = list(NIT = ~1 + PIB + TRM + Balance_Fiscal), data = df_trans,
## lambda = 0.1, family = gaussian(link = "identity"))
##
##
## Fixed Effects:
##
## Coefficients:
## Estimate StdErr z.value p.value
## (Intercept) -0.578480 NA NA NA
## PIB 7.048037 NA NA NA
## TRM 0.000000 NA NA NA
## Balance_Fiscal 0.072126 NA NA NA
##
## Random Effects:
##
## StdDev:
## NIT NIT:PIB NIT:TRM NIT:Balance_Fiscal
## NIT 3.595693e-02 -4.381229e-06 0.000517518 0.0003702396
## NIT:PIB -4.381229e-06 5.992706e-02 -0.017929862 -0.0252718073
## NIT:TRM 5.175180e-04 -1.792986e-02 0.065694556 -0.0301794957
## NIT:Balance_Fiscal 3.702396e-04 -2.527181e-02 -0.030179496 0.0705116556
preds = predict(glm_obj_tr, data = data_train_z)
plot(preds,data_train_z$Costo.de.ventas_dif, main='Generalized linear model Lasso : Lambda bajo')
abline(a=0, b=1, lwd = 2, col = 'red')
| Medidas | Resultados |
|---|---|
| r2 train | 0.4593925 |
| r2 adj train | -0.4509455 |
| mse train | 0.1718498 |
preds = predict(glm_obj_tr, newdata = data_test_z)
r2_model<-r2_score(preds, data_test_z$Costo.de.ventas_dif)
adj_r2_model<-adj_r2_score(preds, data_test_z$Costo.de.ventas_dif)
mse_model<-mean((data_test_z$Costo.de.ventas_dif - preds)^2)
sub_tit = paste("R2", format(r2_model, digits=2, nsmall=2),
"; R2_adj", format(adj_r2_model, digits=2, nsmall=2),
sep = " ", collapse = NULL)
plot(preds,data_test_z$Costo.de.ventas_dif, main='Generalized linear model Lasso : Lambda bajo', sub = sub_tit)
abline(a=0, b=1, lwd = 2, col = 'red')
| Medidas | Resultados |
|---|---|
| r2 test | 0.0129854 |
| r2 adj test | -0.0188538 |
| mse test | 0.1804495 |
## Generalized linear model Lasso
glm_obj_tr <- glmmLasso(Costo.de.ventas_dif~PIB+TRM+Balance_Fiscal, rnd = list(NIT=~1+PIB+TRM+Balance_Fiscal), data = df_trans, lambda=2.4, family = gaussian(link ="identity"))
## Warning in est.glmmLasso.RE(fix = fix, rnd = rnd, data = data, lambda =
## lambda, : Cluster variable should be specified as a factor variable!
## Warning in est.glmmLasso.RE(fix = fix, rnd = rnd, data = data, lambda =
## lambda, : Random slopes are not standardized back!
summary(glm_obj_tr)
## Call:
## glmmLasso(fix = Costo.de.ventas_dif ~ PIB + TRM + Balance_Fiscal,
## rnd = list(NIT = ~1 + PIB + TRM + Balance_Fiscal), data = df_trans,
## lambda = 2.4, family = gaussian(link = "identity"))
##
##
## Fixed Effects:
##
## Coefficients:
## Estimate StdErr z.value p.value
## (Intercept) -0.30123 NA NA NA
## PIB 2.44378 NA NA NA
## TRM 0.00000 NA NA NA
## Balance_Fiscal 0.00000 NA NA NA
##
## Random Effects:
##
## StdDev:
## NIT NIT:PIB NIT:TRM NIT:Balance_Fiscal
## NIT 0.0331860255 0.0001289683 0.0006133315 0.0004802918
## NIT:PIB 0.0001289683 0.0578397446 -0.0168122199 -0.0251150672
## NIT:TRM 0.0006133315 -0.0168122199 0.0642734071 -0.0308541564
## NIT:Balance_Fiscal 0.0004802918 -0.0251150672 -0.0308541564 0.0700757184
preds = predict(glm_obj_tr, data = data_train_z)
plot(preds,data_train_z$Costo.de.ventas_dif, main = 'Generalized linear model Lasso : Lambda alto')
abline(a=0, b=1, lwd = 2, col = 'red')
| Medidas | Resultados |
|---|---|
| r2 train | 0.5651697 |
| r2 adj train | -0.5583754 |
| mse train | 0.1735088 |
preds = predict(glm_obj_tr, newdata = data_test_z)
r2_model<-r2_score(preds, data_test_z$Costo.de.ventas_dif)
adj_r2_model<-adj_r2_score(preds, data_test_z$Costo.de.ventas_dif)
mse_model<-mean((data_test_z$Costo.de.ventas_dif - preds)^2)
sub_tit = paste("R2", format(r2_model, digits=2, nsmall=2),
"; R2_adj", format(adj_r2_model, digits=2, nsmall=2),
sep = " ", collapse = NULL)
plot(preds,data_test_z$Costo.de.ventas_dif, main='Generalized linear model Lasso : Lambda alto', sub = sub_tit)
abline(a=0, b=1, lwd = 2, col = 'red')
| Medidas | Resultados |
|---|---|
| r2 test | 0.0083219 |
| r2 adj test | -0.0236677 |
| mse test | 0.1774586 |